home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Disc to the Future 2
/
Disc to the Future Part II Programmer's Reference (Wayzata Technology)(6013)(1992).bin
/
MAC
/
THINKC
/
4_0
/
USEFUL_C
/
OOPS.C
< prev
next >
Wrap
Text File
|
1990-04-28
|
4KB
|
207 lines
/*
* oops.c
*
* Copyright (c) 1989 Symantec Corporation. All rights reserved.
*
*/
#include "oops.h"
#ifdef DIRECT
#define member memberD
#define sizeofobj sizeofobjD
#define bless blessD
#define __msg __msgD
#else
#define INDIRECT
#endif
void __msg(void);
/*
* new - allocate a new object
*
* The new object is returned. (This implementation initializes the
* object to all-bits-zero, but it may be unwise to rely on this.)
*
* This routine is for use with indirect classes. There is no
* corresponding facility for direct classes.
*
* If an object is created other than by calling this routine, it
* must be marked as belonging to its class by calling "bless" or
* "blessD". (Since allocation of direct objects is the programmer's
* responsibility, "blessD" must always be called.)
*
*/
#ifdef INDIRECT
void *
new(class)
void *class;
{
asm {
moveq #0,d0
movea.l class,a1
move.w (a1),d0 ; D0.L = class size
_NewHandle CLEAR
move.l a0,d0
beq.s @1
suba.l a5,a1 ; A1.W = class ID
movea.l (a0),a0 ; <<indirect>>
move.w a1,(a0)
@1 }
}
#endif INDIRECT
/*
* delete - free an object
*
* This routine is for use with indirect classes. There is no
* corresponding facility for direct classes.
*
*/
#ifdef INDIRECT
void
delete(obj)
void *obj;
{
asm {
move.l obj,d0
beq.s @1
movea.l d0,a0
_DisposHandle
@1 }
}
#endif INDIRECT
/*
* member, memberD - test whether an object is a member of a class
*
* A non-zero value is returned if the object's class, or any of its
* ancestors, is equal to the given class.
*
* "member" is for use only with indirect classes, and "memberD" is
* for use only with direct classes. Do not attempt to use either
* function to test whether a direct object is a member of an indirect
* class, or whether an indirect object is a member of a direct class.
* (Of course, in these cases, the answer is "no"!)
*
*/
short
member(obj, class)
void *obj, *class;
{
asm {
move.l class,d1
sub.l a5,d1 ; D1.W = target class ID
movea.l obj,a1
#ifdef INDIRECT
movea.l (a1),a1 ; <<indirect>>
#endif INDIRECT
move.w (a1),d0 ; D0.W = class ID
@1 cmp.w d0,d1
beq.s @2
lea 2(a5,d0.w),a1 ; A1 ==> class record + 2
move.w (a1)+,d0 ; D0.W = #methods - 1
add.w d0,d0
add.w d0,d0
move.w 4(a1,d0.w),d0 ; D0.W = superclass ID
bne.s @1
@2 }
}
/****************************************************************************
sizeofobj, sizeofobjD [90-04-28] SAX
Use these procedures to get the size of a single class-object without
including the inherited variables.
****************************************************************************/
short
sizeofobj(
void *obj )
{
asm {
movea.l obj,a1
#ifdef INDIRECT
movea.l (a1),a1 ; <<indirect>>
#endif INDIRECT
move.w (a1),d0 ; D0.W = class ID
lea 0(a5,d0.w),a1 ; A1 ==> class record
move.w (a1)+,d1 ; D1.W = sizeof class
move.w (a1)+,d0 ; D0.W = #methods - 1
add.w d0,d0
add.w d0,d0
move.w 4(a1,d0.w),d0 ; D0.W = superclass ID
bne.s @1 ; We do have a superclass
subq #2,d1 ; Adjust for class ID
bra.s @2
@1 lea 0(a5,d0.w),a1 ; A1 ==> class record of super
move.w (a1),d2 ; D2.W = sizeof class of super
sub.w d2,d1
@2 move.w d1,d0
}
}
/*
* bless, blessD - mark an object as being of a particular class
*
* If an object is created other than by "new", this routine must
* be called to mark it as a member of its class.
*
* Do not use this routine to change an object's class!
*
*/
void
bless(obj, class)
void *obj, *class;
{
asm {
move.l class,d1
sub.l a5,d1 ; D1.W = class ID
movea.l obj,a1
#ifdef INDIRECT
movea.l (a1),a1 ; <<indirect>>
#endif INDIRECT
move.w d1,(a1)
}
}
/*
* __msg, __msgD - message dispatcher
*
* The dispatcher is called only from code generated by the compiler.
*
*/
void
__msg()
{
asm {
movea.l 4(sp),a1
move.w -(a1),d2 ; D2.W = message ID
movea.l 8(sp),a1
#ifdef INDIRECT
movea.l (a1),a1 ; <<indirect>>
#endif INDIRECT
@1 move.w (a1),d0
lea 2(a5,d0.w),a1 ; A1 ==> class record + 2
move.w (a1)+,d0 ; D0.W = #methods - 1
@2 move.w (a1)+,d1 ; D1.W = method ID
cmp.w (a1)+,d2
dbeq d0,@2
bne.s @1 ; not found - search superclass
lea 0(a5,d1.w),a0 ; A0 ==> method
}
}